home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 3
/
Info_Mac_1994-01.iso
/
Graphics
/
Utility
/
NIH-Image 1.52
/
Macros
/
LUT Macros
< prev
next >
Wrap
Text File
|
1993-08-05
|
8KB
|
376 lines
macro 'Export LUT [E]';
{
Copies the current look-up table to the Area(Red), Mean(Green) and
Perimeter/Length(blue) columns. Max Measurements must be set to
256 or greater.
}
var
i:integer;
v:real;
begin
RequiresVersion(1.45);
SetCounter(256);
SetOptions('Area,Mean, Perimeter');
for i:=0 to 255 do begin
rArea[i+1]:=RedLut[i];
rMean[i+1]:=GreenLut[i];
rLength[i+1]:=BlueLut[i];
end;
ShowResults;
SetExport('Measurements');
Export('RGB LUT');
end;
macro 'Invert LUT [I]';
var
i:integer;
begin
for i:=1 to 254 do begin
RedLUT[i]:=255-RedLut[i];
GreenLUT[i]:=255-GreenLut[i];
BlueLUT[i]:=255-BlueLut[i];
end;
UpdateLUT;
end;
macro 'Log Tranform';
var
i,v:integer;
ln255:real;
BEGIN
RedLUT[255]:=0;
GreenLUT[255]:=0;
BlueLUT[255]:=0;
ln255:=ln(255);
for i:=1 to 255 DO begin
v:=round(ln(i)*255.0/ln255);
RedLUT[255-i]:=v;
GreenLUT[255-i]:=v;
BlueLUT[255-i]:=v;
end;
UpdateLUT;
END.
macro 'Gamma Tranform… [G]';
var
i,v:integer;
n,mode,min,max:integer
gamma,mean:real;
begin
gamma:=GetNumber('Gamma(0.1-3.0):',2);
measure;
GetResults(n,mean,mode,min,max);
ShowMessage('min=',min:1,'\max=',max:1);
for i:=1 to 254 DO begin
if (i>min) and (i<max)
then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
else begin
if i<=min then v:=0 else v:=255;
end;
RedLUT[i]:=255-v;
GreenLUT[i]:=255-v;
BlueLUT[i]:=255-v;
end;
UpdateLUT;
end;
macro 'Square Tranform';
var
i,v:integer;
sqr255:real;
BEGIN
sqr255:=sqr(255.0);
for i:=1 to 255 DO begin
v:=round(sqr(i)*255.0/sqr255);
RedLUT[255-i]:=v;
GreenLUT[255-i]:=v;
BlueLUT[255-i]:=v;
end;
UpdateLUT;
END.
macro 'Square Root Tranform';
var
i,v:integer;
sqrt255:real;
BEGIN
sqrt255:=sqrt(255.0);
for i:=1 to 255 DO begin
v:=round(sqrt(i)*255.0/sqrt255);
RedLUT[255-i]:=v;
GreenLUT[255-i]:=v;
BlueLUT[255-i]:=v;
end;
UpdateLUT;
END;
macro 'Reset LUT [R]';
begin
ResetGrayMap;
end;
macro 'Plot LUT [P]';
var
i,xscale,yscale:real;
width,height,margin,pwidth,pheight:integer;
xbase,ybase:integer;
begin
SaveState;
margin:=25;
pwidth:=400;
pheight:=125;
width:=pwidth+2*margin;
height:=pheight*3+2*margin;
SetNewSize(width,height);
SetBackground(0);
MakeNewWindow('LUT');
xscale:=(pwidth-2)/256;
yscale:=(pheight-1)/256;
SetForeground(252);
xbase:=margin; ybase:=margin;
MoveTo(xbase,ybase);
for i:=0 to 255 do
LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
SetForeground(255);
MakeRoi(xbase,ybase,pwidth,pheight);
FlipVertical;
DrawBoundary;
SetForeground(253);
ybase:=ybase+pheight-1;
MoveTo(xbase,ybase);
for i:=0 to 255 do
LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
SetForeground(255);
MakeRoi(xbase,ybase,pwidth,pheight);
FlipVertical;
DrawBoundary;
SetForeground(254);
ybase:=ybase+pheight-1;
MoveTo(xbase,ybase);
for i:=0 to 255 do
LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
SetForeground(255);
MakeRoi(xbase,ybase,pwidth,pheight);
FlipVertical;
DrawBoundary;
KillRoi;
RedLUT[252]:=255; GreenLUT[252]:=0; BlueLUT[252]:=0;
RedLUT[253]:=0; GreenLUT[253]:=255; BlueLUT[253]:=0;
RedLUT[254]:=0; GreenLUT[254]:=0; BlueLUT[254]:=255;
UpdateLUT;
SetFont('Geneva');
SetFontSize(9);
SetText('Centered');
MoveTo(margin+4,height-margin+8);
writeln(0:1:2);
MoveTo(margin+pwidth,height-margin+8);
writeln(255:1:2);
RestoreState;
end;
macro 'Posterize…';
var
level,i:integer
delta,steps,StepSize,NextStep:real;
begin
steps:=GetNumber('Number of Gray Steps(2-256):',8);
StepSize:=256/steps;
delta:=256/(steps-1);
NextStep:=trunc(StepSize);
level:=255;
for i:=0 to 255 do begin
if i>=NextStep then begin
NextStep:=trunc(NextStep+StepSize);
level:=level-delta;
UpdateLUT;
end;
if level<0 then level:=0;
RedLUT[i]:=level;
GreenLUT[i]:=level;
BlueLUT[i]:=level;
end;
end;
macro 'Make Four Ramp LUT';
var
i,entry:integer;
BEGIN
entry:=0;
for i:=0 to 63 DO begin
RedLUT[entry]:=255-i*4;
GreenLUT[entry]:=255-i*4;
BlueLUT[entry]:=255-i*4;
entry:=entry+1;
end;
for i:=0 to 63 DO begin
RedLUT[entry]:=255-i*4;
GreenLUT[entry]:=0;
BlueLUT[entry]:=0;
entry:=entry+1;
end;
for i:=0 to 63 DO begin
RedLUT[entry]:=0;
GreenLUT[entry]:=255-i*4;
BlueLUT[entry]:=0;
entry:=entry+1;
end;
for i:=0 to 63 DO begin
RedLUT[entry]:=0;
GreenLUT[entry]:=0;
BlueLUT[entry]:=255-i*4;
entry:=entry+1;
end;
UpdateLUT;
end.
macro 'Set Pixels Red…';
var
v1,v2,i:integer;
begin
v1:=GetNumber('Starting Pixel Value(1-254)',10);
v2:=GetNumber('Ending Pixel Value(1-254)',10);
if v2<v1 then begin
PutMessage('Ending value less than starting value.');
exit;
end;
for i:=v1 to v2 do begin
RedLUT[i]:=255;
GreenLUT[i]:=0;
BlueLUT[i]:=0;
end;
end;
UpdateLUT;
end;
macro 'Nearly Gray LUT…';
{
Here is a macro that changes the LUT to make the values near 128 fairly visible when making polygon and line selections which use XOR drawing mode.
Play around with it to get better results. It was written on the
(incorrect) assumption that brightness = r+g+b.
j is i xor 255 and also white is 255,255,255 not 0,0,0.
{The brightness of each pixel is not quite right, there is a better way to get different colors with same brightness...)
--Edward J. Huff (huff@mcclb0.med.nyu.edu)
}
var
i,j,d: integer;
begin
while (d < 1) or (d > 63) do
d := GetNumber('Amount of color',20);
for i := d*2 to 127 do begin
j := 255 - i;
RedLUT[i] := j + d;
GreenLUT[i] := j + d;
BlueLUT[i] := j - d*2;
RedLUT[j] := i - d*2;
GreenLUT[j] := i + d;
BlueLUT[j] := i + d;
end;
UpdateLUT;
end;
macro 'Color Merge Two Images';
{
Merges a "red" image and a "green" image to create a
composite color image. The macro does this by scaling both
images to 0-15, multiplying the second by 16, creating a
single 8-bit by ORing the two 4-bit images, and then
generating a custom red and green LUT to display the
composite image.
}
var
i,w1,w2,h1,h2,merged:integer;
begin
SaveState;
if nPics<>2 then begin
PutMessage('This macro operates on exactly two images.');
exit;
end;
SelectPic(1);
GetPicSize(w1,h1);
SelectPic(2);
GetPicSize(w2,h2);
if (w1<>w2) or (h1<>h2) then begin
PutMessage('The two images must have the same width and height.');
exit;
end;
SetNewSize(w1,h2);
MakeNewWindow('Merged');
merged:=PicNumber;
SelectPic(1);
SelectAll;
Copy;
SelectPic(merged);
Paste;
SelectAll;
MultiplyByConstant(1/16);
ChangeValues(0,0,1);
ChangeValues(16,16,15);
SelectPic(2);
SelectAll;
Duplicate('Temp');
MultiplyByConstant(1/16);
ChangeValues(16,16,15);
MultiplyByConstant(16);
ChangeValues(0,0,1);
SelectAll;
Copy;
SelectPic(merged);
Paste;
DoOr;
for i:=0 to 255 do begin
RedLut[i]:=(i mod 16)*16;
GreenLut[i]:=(i div 16)*16;
BlueLut[i]:=0;
end;
UpdateLut;
SelectPic(nPics);
Dispose; {Temp}
RestoreState;
end;
macro 'Move Slice Up [U]';
var
lower,upper:integer;
begin
GetThresholds(lower,upper);
lower:=lower-1;
upper:=upper-1;
if lower<1 then lower:=1;
if lower>254 then lower:=254;
if upper<lower then upper:=lower;
if upper>254 then upper:=254;
SetDensitySlice(lower,upper);
ShowMessage(lower:4,upper:4)
end;
macro 'Move Slice Down [D]';
var
lower,upper:integer;
begin
GetThresholds(lower,upper);
lower:=lower+1;
upper:=upper+1;
if lower<1 then lower:=1;
if lower>254 then lower:=254;
if upper<lower then upper:=lower;
if upper>254 then upper:=254;
SetDensitySlice(lower,upper);
ShowMessage(lower:4,upper:4)
end;